home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / Pascal / Applications / NIH Image 1.62b11 / Macros / FFT Macros < prev    next >
Text File  |  1996-06-10  |  10KB  |  420 lines
  1. var  {global }
  2.    FilterSize: real; {0-100% of image size}
  3.    TransitionWidth: real; {0-100% of filter radius}
  4.     PlotFilter: boolean;
  5.  
  6. macro 'FFT [F]';
  7. begin
  8.             fft('foreward');
  9. end;
  10.  
  11.  
  12. macro 'Abitrary Selection FFT [A]';
  13. var
  14.    pid1, pid2, x, y, w,h, size: integer;
  15.    scale: real;
  16. begin
  17.    GetRoi(x, y, w, h);
  18.    if w = y then begin
  19.       SelectAll;
  20.       GetRoi(x, y, w, h);
  21.    end;
  22.    if w > h then begin
  23.       x := x + (w - h) div 2;
  24.       w := h;
  25.        MakeRoi(x, y, w, hª);
  26.    end;
  27.    if h > w then begin
  28.       y := y+ (h - w) div 2;
  29.       h := w;
  30.        MakeRoi(x, y, w, h);
  31.    end;
  32.    size := 2048;
  33.    if w <= 32 then size := 32
  34.    else if w <= 64 then size := 64
  35.    else if w <= 128 then size := 128
  36.    else if w <= 256 then size := 256
  37.    else if w <= 512 then size := 512
  38.    else if w <= 1024 then size := 1024;
  39.    scale := size / w;
  40.    SetScaling('Bilinear; New Window');
  41.    ScaleAndRotate(scale, scale, 0);
  42.    pid1 := pidNumber;
  43.             fft('foreward');
  44.    pid2 := pidNumber;
  45.    SelectPic(pid1);
  46.    dispose;
  47.    SelectPic(pid2);
  48. end;
  49.  
  50.  
  51. macro 'Inverse FFT [I]';
  52. begin
  53.             fft('Inverse');
  54. end;
  55.  
  56.  
  57. macro 'Inverse FFT with Custom Mask [M]';
  58. var
  59.    w,h, pixWidth, i, nSmooths: integer;
  60. begin
  61.    GetPicSize(w, h);
  62.    GetHistogram(0, 0, w,h);
  63.    if (histogram[0] = 0) and (histogram[255] = 0) then begin
  64.        PutMessage('No mask. You need to edit the power spectrum using black to pass frequencies or white to filter freqwencies.');
  65.        exit;
  66.    end;
  67.    pixWidth := GetNumber('Transition Width in Pixels:', 6, 0);
  68.    nSmooths := pixWidth div 2;
  69.    if histogram[0] <> 0 then
  70.        ChangeValues(1, 255, 255)
  71.    else
  72.        ChangeValues(0, 254, 0);
  73.    for i := 1 to nSmooths do
  74.       filter('smooth more');
  75.             fft('Inverse with Filter');
  76. end;
  77.  
  78. macro 'Inverse FFT with Filter';
  79. begin
  80.             fft('Inverse with Filter');
  81. end;
  82.  
  83. {
  84. procedure fftFilter(type: string; percent: integer);
  85. var
  86.    width, height, size, loc: integer;
  87. begin
  88.    if percent < 0 then
  89.       percent := 0;
  90.    if percent > 100 then
  91.       percent := 100;
  92.    SaveState;
  93.             fft('foreward');
  94.    GetPicSize(width, height);
  95.    size := round(( percent/100) * width);
  96.    loc := width div 2 - size/2;
  97.    MakeOvalRoi(loc, loc, size, size);
  98.    if type = 'high' then
  99.       SetForeground(0)
  100.    else
  101.       SetForeground(255);
  102.    Fill;
  103.             fft('Inverse');
  104.    RestoreState;
  105. end;
  106.  
  107.  
  108. macro 'High Pass Filter... [H]';
  109. var
  110.    percent: integer;
  111. begin
  112.    percent := GetNumber('Filter size (0-100%):', 10, 0);
  113.    fftFilter('high', percent);
  114. end;
  115.  
  116. macro 'Low Pass Filter... [L]';
  117. var
  118.    percent: integer;
  119. begin
  120.    percent := GetNumber('Filter size (0-100%):', 20, 0);
  121.    fftFilter('low', percent);
  122. end;
  123. }
  124.  
  125.  
  126. procedure MakeFilter(size, tWidth, min, max: real);
  127. var
  128.    width, height, roiSize: integer;
  129.    pixWidth, i, loc, v: integer;
  130. begin
  131.    SaveState;
  132.    if size > 100 then size := 100;
  133.    if size < 0 then size := 0;
  134.    if tWidth > 100 then tWidth := 100;
  135.    if tWidth < 0 then tWidth := 0;
  136.    if min > 100 then min := 100;
  137.    if min < 0 then min := 0;
  138.    if max > 100 then max := 100;
  139.    if max < 0 then max := 0;
  140.    if min > max then min := max;
  141.    GetPicSize(width, height);
  142.    SelectAll;
  143.    size := round(size / 100 * width);
  144.    min := round(min / 100 * 255);
  145.    max := round(max / 100 * 255);
  146.    Setbackground(min);
  147.    Clear;
  148.     roiSize := size;
  149.     pixWidth := round(size div 2 * (tWidth/100));
  150.     if pixWidth < 1 then
  151.        pixWidth := 1;
  152.     for i := 1 to pixWidth do begin
  153.        loc := width div 2 - roiSize/2;
  154.        MakeOvalRoi(loc, loc, roiSize, roiSize);
  155.        v := (max-min)  *  exp(-4.5 *  sqr(1 - i  / pixWidth)) + min; {gaussian shape}
  156.        SetForeground(v);
  157.        Fill;
  158.        roiSize := roiSize - 2;
  159.    end;
  160.    KillRoi;
  161.    RestoreState;
  162. end;
  163.  
  164.  
  165. procedure doFilter(filterType: string);
  166. var
  167.    width, height: integer;
  168. begin
  169.    if FilterSize = 0 then
  170.       FilterSize := 20;
  171.    if TransitionWidth = 0 then
  172.       TransitionWidth := 50;
  173.    FilterSize := GetNumber('Filter size (0-100%):', FilterSize, 0);
  174.    TransitionWidth := GetNumber('Transition Width (0-100%):', TransitionWidth, 0);
  175.    if TransitionWidth = 0 then
  176.       TransitionWidth := 0.0001;
  177.             fft('foreward');
  178.    MakeFilter(FilterSize, TransitionWidth, 0, 100);
  179.    if FilterType = 'high' then
  180.       Invert;
  181.    if PlotFilter then begin
  182.       getPicSize(width, height);
  183.       MakeLineRoi(0, height / 2, width, height / 2);
  184.       PlotProfile;
  185.       KillRoi;
  186.    end;
  187.    fft('Inverse with Filter');
  188. end;
  189.  
  190.  
  191. macro '(---'; begin end;
  192.  
  193.  
  194. macro 'High Pass Filter... [H]';
  195. begin
  196.   doFilter('high');
  197. end;
  198.  
  199. macro 'Low Pass Filter... [L]';
  200. begin
  201.   doFilter('low');
  202. end;
  203.  
  204. macro 'Toggle Filter Plotting ... [T]';
  205. begin
  206.   if PlotFilter then begin
  207.       PlotFilter := false;
  208.       PutMessage('Filter profiles will not be plotted.');
  209.   end else begin
  210.       PlotFilter := true;
  211.       PutMessage('Filter profiles will  be plotted.');
  212.   end;
  213. end;
  214.  
  215.  
  216. macro '(---'; begin end;
  217.  
  218.  
  219. macro 'Autocorrelation';
  220. var
  221.    fft1, fft2: integer;
  222. begin
  223.             fft('foreward');
  224.    fft1 := pidNumber;
  225.    ImageMath('cmul', fft1, fft1, 1, 0, 'FFT2');
  226.    fft2 := pidNumber;
  227.    SelectPic(fft1);
  228.    Dispose;
  229.    SelectPic(fft2);
  230.             fft('Inverse');
  231.    fft('Swap Quadrants');
  232.   SetPicName('Autocorrelation')
  233. end;
  234.  
  235.  
  236. macro 'Autocorrelation with Padding';
  237. var
  238.    pad, fft1, fft2: integer;
  239.    width, height: integer;
  240.    n,mean,mode,min,max: real;
  241. begin
  242.    SelectAll;
  243.     Measure;
  244.    GetResults(n,mean,mode,min,max);
  245.    Copy;
  246.    GetPicSize(width, height);
  247.    SetNewSize(width * 2, height * 2);
  248.    Setbackgrount(round(mean));
  249.    MakeNewWindow('Padded Image');
  250.    MakeRoi(0, 0, width, height);
  251.    Paste;
  252.    KillRoi;
  253.    pad := pidNumber;
  254.             fft('foreward');
  255.    fft1 := pidNumber;
  256.    ImageMath('cmul', fft1, fft1, 1, 0, 'FFT2');
  257.    fft2 := pidNumber;
  258.    SelectPic(pad);
  259.    Dispose;
  260.    SelectPic(fft1);
  261.    Dispose;
  262.    SelectPic(fft2);
  263.             fft('Inverse');
  264.    fft('Swap Quadrants');
  265.   SetPicName('Autocorrelation')
  266. end;
  267.  
  268.  
  269. macro 'Correlate Two Images' ;
  270. var
  271.    pic1, pic2, fft1, fft2, out: integer;
  272. begin
  273.    if nPics <> 2 then begin
  274.       PutMessage('Exactly two images required.');
  275.       exit;
  276.    end;
  277.    pic1 := pidNumber;
  278.    NextWindow;
  279.    pic2 := pidNumber;
  280.             fft('foreward');
  281.    fft2 := pidNumber;
  282.    SelectPic(pic1);
  283.    fft('foreward');
  284.    fft1 := pidNumber;
  285.    ImageMath('cmul', fft1, fft2, 1, 0, 'FFT2');
  286.    out := pidNumber;
  287.    SelectPic(fft1);
  288.    Dispose;
  289.    SelectPic(fft2);
  290.    Dispose;
  291.    SelectPic(out);
  292.    fft('Inverse');
  293.    fft('Swap Quadrants');
  294.    SetPicName('Correlation');
  295.    SurfacePlot;
  296. end;
  297.  
  298.  
  299. macro '(---'; begin end;
  300.  
  301. macro 'Make Filter...';
  302. var
  303.    width, height: integer;
  304. begin
  305.    if FilterSize = 0 then
  306.       FilterSize := 20;
  307.    if TransitionWidth = 0 then
  308.       TransitionWidth := 50;
  309.    FilterSize := GetNumber('Filter size (0-100%):', FilterSize, 0);
  310.    TransitionWidth := GetNumber('Transition Width (0-100%):', TransitionWidth, 0);
  311.    if TransitionWidth = 0 then
  312.       TransitionWidth := 0.0001;
  313.             Duplicate('Filter');
  314.    MakeFilter(FilterSize, TransitionWidth, 0, 100);
  315. end;
  316.  
  317.  
  318. macro 'Redisplay Power Spectrum';
  319. begin
  320.    fft('Display Power Spectrum');
  321. end;
  322.  
  323. macro 'Swap Quadrants';
  324. begin
  325.    fft('Swap Quadrants');
  326. end;
  327.  
  328.  
  329. macro '(---'; begin end;
  330.  
  331.  
  332. procedure roi(size: integer);
  333. var
  334.   width, height: integer;
  335. begin
  336.   GetPicSize(width, height);
  337.   if size > width then
  338.      size := width;
  339.   if width = 0 then begin
  340.      PutMessage('No image window open.');
  341.      exit;
  342.   end;
  343.    MakeRoi(width/2 - size/2, height/2 - size/2, size, size);
  344. end;
  345.  
  346. macro 'Create 32 x 32 selection [1]'; begin roi(32) end;
  347. macro 'Create 64 x 64 selection [2]'; begin roi(64) end;
  348. macro 'Create 128 x 128 selection [3]'; begin roi(128) end;
  349. macro 'Create 256 x 256 selection [4]'; begin roi(256) end;
  350. macro 'Create 512 x 512 selection [5]'; begin roi(512) end;
  351.  
  352.  
  353. procedure AnnularSelection(color: integer);
  354. var
  355.   x1,x2,y1,y2,top,left,width,height, w, h:integer;
  356.   xcenter,ycenter,radius1, radius2:integer;
  357. begin
  358.   if pos('FFT',WindowTitle) <> 1 then begin
  359.      beep;
  360.      PutMessage('Frequency domain (FFT) image required.');
  361.      exit;
  362.   end;
  363.   GetPicSize(w,h);
  364.   GetLine(x1,y1,x2,y2,width);
  365.   if x1<0 then begin
  366.      beep;
  367.      PutMessage('Line selection required.');
  368.      exit;
  369.   end;
  370.   SaveState;
  371.   SetForeground(color);
  372.   xcenter:=w/2;
  373.   ycenter:=h/2;
  374.   radius1:=sqrt(sqr(abs(x1-xcenter))+sqr(abs(y1-ycenter)));
  375.   radius2:=sqrt(sqr(abs(x2-xcenter))+sqr(abs(y2-ycenter)));
  376.   if radius1 < radius2 then begin
  377.         MakeOvalROI(xcenter-radius1,ycenter-radius1,radius1*2,radius1*2);
  378.         copy;
  379.         setbackgroundcolor(0);
  380.         MakeOvalROI(xcenter-radius2,ycenter-radius2,radius2*2,radius2*2);
  381.         fill;
  382.         paste;
  383.         killroi;
  384.   end;
  385.   MakeOvalROI(xcenter-radius2,ycenter-radius2,radius2*2,radius2*2);
  386.   copy;
  387.   setbackgroundcolor(0);
  388.   MakeOvalROI(xcenter-radius1,ycenter-radius1,radius1*2,radius1*2);
  389.   fill;
  390.   paste;
  391.   killroi;
  392.   RestoreState;
  393. end;
  394.  
  395. macro '(---'; begin end;
  396.  
  397. {The annular selection macros are designed to be used in the power
  398. spectrum window. Using the  line selection tool, a line is drawn that
  399. extends through some range of spatial frequencies. This line should be radial
  400. from the center of the window since the selection will be from the central to
  401. distal portion of the line. After making the line selection, typing W will
  402. cause a black annular selection to be made. Following this selection with the
  403. Inverse command from the FFT macros will result in passing the range of
  404. frequencies selected in the inverse transform. If you want to use the selection
  405. as a notch filter, then type W to create a white annular selection.}
  406.  
  407. macro 'Black Annular Selection - Pass [B]';
  408. begin
  409.    AnnularSelection(255);
  410. end;
  411.  
  412. macro 'White Annular Selection - Notch [W]';
  413. begin
  414.    AnnularSelection(0);
  415. end;
  416.  
  417.  
  418.  
  419.  
  420.